Floppyshop 2/Floppyshop - 2.zip/Floppyshop - 2.iso/art&graf.ix/art-0039/source/manywind.mod

Text File | 1997-04-16 | 15KB | 571 lines

IMPLEMENTATION MODULE ManyWindows;

(*-----------------------------------------------------------------------*)
(* See notes in defintion module.                                        *)
(*                                                                       *)
(*                                                                       *)
(*  7/ 9/89 LGM : Original.                                              *)
(*-----------------------------------------------------------------------*)
(* IMPORT Trace; *)
FROM     SYSTEM         IMPORT     ADR, ADDRESS;
FROM     Application    IMPORT     appl_init, appl_exit;
FROM     Forms         IMPORT     form_alert;
IMPORT     Window;
FROM       Window        IMPORT     Components, ComponentSet, wind_update;
IMPORT     Graphics;
IMPORT    Forms;
IMPORT     VDI;
FROM     Strings     IMPORT     (* type *) String,
                           (* func *) Concat, Assign,
                                         Delete, Pos, Length, Copy ;
FROM     Bios         IMPORT getRez;
FROM     Storage        IMPORT ALLOCATE, DEALLOCATE, Cleanup, MaxBlocks;

CONST
    NULLCHAR     =     0C;
    CMaxWindows    =     4;

TYPE
      ActiveWindows     = ARRAY [ 0 .. CMaxWindows-1 ] OF WindowPtr;

VAR
     TheWindows        : ActiveWindows;
    WindowCount        : CARDINAL;
     DesktopWindow        : WindowPtr;

    ScreenUpdateCount    : INTEGER=0; (* screen being updated *)

        dumi            : INTEGER;
    dumc            : CARDINAL;


PROCEDURE NullFill ( VAR str : ARRAY OF CHAR );
  VAR i : CARDINAL;
  BEGIN
    FOR i := 0 TO SHORT(HIGH(str)) DO str[i] := NULLCHAR END;
  END NullFill;


(* a useful utility *)
PROCEDURE ShowAlert(  s      : ARRAY OF CHAR; (* Alert string to show *)
                      n, def : CARDINAL ) : CARDINAL;
                          (* ok button = 1 *)
CONST
  IconStr       = '[3][';
  OneButtonStr  = '][  OK  ]';
  TwoButtonStr  = '][  OK  |CANCEL]';

VAR
  str         : String ;
  result     : INTEGER ;
  DefaultButton,
  i         : CARDINAL ;

  BEGIN
    DefaultButton := def;
    NullFill(str);
    Concat(IconStr,s,str);
    IF n = 1 THEN
       Concat(str,OneButtonStr,str);
    ELSE
       Concat(str,TwoButtonStr,str);
    END; (* if *)
    RETURN Forms.form_alert(DefaultButton,str) ;
  END ShowAlert ;


PROCEDURE ToCornersRect( in : XYWHRect; VAR out : CornersRect );
  BEGIN
    WITH out DO
      XL := in.X;
      YL := in.Y;
      XR := in.X + in.Width  - 1;
      YR := in.Y + in.Height - 1;
    END;
  END ToCornersRect;


PROCEDURE ToXYWHRect( in :  CornersRect; VAR out : XYWHRect; );
  BEGIN
    IF in.XL > in.XR THEN
      WITH out DO
        X     := in.XR;
        Y    := in.YR;
        Width     := in.XL - in.XR + 1;
        Height    := in.YL - in.YR + 1;
      END;
    ELSE
      WITH out DO
        X     := in.XL;
        Y    := in.YL;
        Width     := in.XR - in.XL + 1;
        Height    := in.YR - in.YL + 1;
      END;
    END;
  END ToXYWHRect;


PROCEDURE BeginScreenUpdate;
  BEGIN
    IF ScreenUpdateCount = 0 THEN
    dumc := wind_update(1);
    END;
    INC(ScreenUpdateCount);
  END BeginScreenUpdate;


PROCEDURE EndScreenUpdate;
  BEGIN
    IF ScreenUpdateCount = 1 THEN
    dumc := wind_update(0);
    END;
    DEC(ScreenUpdateCount);
  END EndScreenUpdate;


(* return window number, negative if not opened by me *)
PROCEDURE GetWindowIndex( wp : WindowPtr ) : INTEGER;
  VAR i : INTEGER;
  BEGIN
    i:=0;
    WHILE ( i < CMaxWindows )
     AND  ( TheWindows[i] <> wp ) DO
       INC(i);
    END;
    IF ( wp = NIL         )
    OR ( i >= CMaxWindows ) THEN
       i := -1; END;
    RETURN i;
  END GetWindowIndex;


PROCEDURE NewWindow() : WindowPtr;
  VAR wp : WindowPtr;
      i  : INTEGER;
  BEGIN
    i:=0;
    WHILE ( i < CMaxWindows )
     AND  ( TheWindows[i] <> NIL ) DO
       INC(i);
    END;

    wp := NIL;
    IF WindowCount < CMaxWindows THEN
       NEW( wp );
       IF wp <> NIL THEN
          TheWindows[i] := wp;
          INC(WindowCount);

       ELSE
          dumc := ShowAlert('Unable To Create Window',1,1);
       END;

    ELSE
       dumc := ShowAlert('To Many Open Windows',1,1);
    END;
    RETURN wp;
  END NewWindow;


PROCEDURE DestroyWindow( wp : WindowPtr );
  VAR i : INTEGER;
  BEGIN
    i := GetWindowIndex(wp);
    IF i < 0 THEN
       dumc := ShowAlert('Cannot Dispose of wondow.|Window pointer not found',1,1);
    ELSE
       TheWindows[i] := NIL;
       DISPOSE( wp );
    END;
  END DestroyWindow;


PROCEDURE GetWindowHandle( wp : WindowPtr ) : INTEGER;
  BEGIN
    RETURN wp^.Handle;
  END GetWindowHandle;


PROCEDURE GetWindowPtr( handle : INTEGER ) : WindowPtr;
  VAR i : CARDINAL;
  BEGIN
    FOR i:= 0 TO CMaxWindows-1 DO
      IF TheWindows[i]^.Handle = handle THEN
         RETURN TheWindows[i];
      END;
    END;
    RETURN NIL;
  END GetWindowPtr;


PROCEDURE GetDesktopWindowInfo( wp : WindowPtr );
  CONST
    DesktopWindow = 0;
    WorkXYWH      = 4;

  BEGIN
    (* get max window size on the desk top *)
    IF  Window.wind_get( DesktopWindow,
                         WorkXYWH, (* input *)
                         wp^.Outer.X,
                         wp^.Outer.Y,
                         wp^.Outer.Width,
                         wp^.Outer.Height ) = 0 THEN
       dumc := ShowAlert('Cannot get destop size',1,1);
      HALT
     END;
  END GetDesktopWindowInfo;


PROCEDURE HideMouse;
  BEGIN
    VDI.v_hide_c( VDIHandle );
  END HideMouse;


PROCEDURE ShowMouse;
  BEGIN
    VDI.v_show_c( VDIHandle, FALSE ); (* Force mouse to be shown *)
  END ShowMouse;


PROCEDURE StartApplication;
  VAR
     i       : INTEGER;
     workin  : ARRAY [0 .. 100] OF INTEGER;
     workout : ARRAY [0 .. 100] OF INTEGER;
     str     : String;
  BEGIN
    AESApplId := appl_init();

    (* get VDI handle used by AES *)
    VDIHandle :=
          Graphics.graf_handle(DesktopWindow^.Font.CharWidth,
                               DesktopWindow^.Font.CharHeight,
                   DesktopWindow^.Font.Width,
                   DesktopWindow^.Font.Height);
    GetDesktopWindowInfo( DesktopWindow );

    (* Open VDI Virtual workstation for this program *)
    FOR i:=0 TO 9 DO workin[i]:=1; END;
    workin[10]:=2; (* set raster co-ordinates *)
    VDI.v_opnvwk( workin, VDIHandle, workout );
    IF ( VDIHandle = 0 ) THEN
       i := ShowAlert( "Unable to open | virtual workstation]",1,1);
       HALT;
    END; (* if *)
    (* set fill for screen clear *)
    i := VDI.vsf_interior(VDIHandle, VDI.SolidFill);
    i := VDI.vsf_color(VDIHandle, VDI.White);
  END StartApplication;


PROCEDURE CalcWorkareaSize( wp : WindowPtr ); (* use AWindow *)
  CONST
    ReturnWorkareaSize = 1;

  BEGIN
    (* Now get work area size of AWindow using border components *)
   IF Window.wind_calc( ReturnWorkareaSize,
                           wp^.Components,
                           wp^.Outer.X,
                           wp^.Outer.Y,
                           wp^.Outer.Width,
                           wp^.Outer.Height,

                           wp^.Workarea.X,
                           wp^.Workarea.Y,
                           wp^.Workarea.Width,
                           wp^.Workarea.Height ) = 0 THEN END;
  END CalcWorkareaSize;



PROCEDURE CreateAWindow( components : ComponentSet) : WindowPtr ;
  CONST
     WindowName = 2;
  VAR
    wp            : WindowPtr;
    WindowOptions,i : INTEGER;
    str : String;
  BEGIN
    wp := NIL;
    wp := NewWindow();
    IF ( wp = NIL ) THEN RETURN NIL; END;
    wp^ := DesktopWindow^;
    wp^.Components := components;
    wp^.State := WindowSSet{topped};
    wp^.Title[0] := 0C;
    wp^.Info[0]  := 0C;
    wp^.RectList.Set := FALSE;
    wp^.RectList.First := TRUE;
    CalcWorkareaSize( wp );

    (* Now create the full size window *)
    wp^.Handle :=
        Window.wind_create( wp^.Components,
                            wp^.Outer.X,
                            wp^.Outer.Y,
                            wp^.Outer.Width,
                            wp^.Outer.Height );

    IF ( NAME IN wp^.Components ) THEN
        SetAWindowTitle(wp, '*** No Title Set Yet ***');
    END;
    IF ( INFO IN wp^.Components ) THEN
        SetAWindowInfo(wp, '*** No Information Set yet ***');
    END;
    wp^.State := WindowSSet{};
    RETURN wp;
  END CreateAWindow;


PROCEDURE SetAWindowTitle ( wp : WindowPtr; title : ARRAY OF CHAR );
  CONST
        WindowName = 2;

  BEGIN
     IF ( GetWindowIndex(wp) < 0     )
     OR NOT ( NAME IN wp^.Components ) THEN
        RETURN
     END;
     HideMouse;
     Assign (title, wp^.Title); (* save the title somewhere permanent *)
     IF Window.wind_set_long( wp^.Handle,
                         WindowName,
                         ADR(wp^.Title), LONGCARD(0))=0 THEN END;
     ShowMouse;
  END SetAWindowTitle;


PROCEDURE SetAWindowInfo ( wp : WindowPtr; info : ARRAY OF CHAR );
  CONST
        WindowInfo = 3;

  BEGIN
     IF ( GetWindowIndex(wp) < 0     )
     OR NOT ( INFO IN wp^.Components ) THEN
        RETURN
     END;
     HideMouse;
     Assign (info, wp^.Info); (* save the title somewhere permanent *)
     IF Window.wind_set_long( wp^.Handle,
                         WindowInfo,
                         ADR(wp^.Info), LONGCARD(0))=0 THEN END;
     ShowMouse;
  END SetAWindowInfo;



PROCEDURE OpenAWindow( wp : WindowPtr ); (* Will use values in AWindow *)
  VAR
     i : INTEGER;
     str     : String;

  BEGIN
    IF  ( open IN wp^.State ) THEN
       dumi := ShowAlert( "The Window is ALREADY OPEN!",1,1);
       RETURN
    ELSIF GetWindowIndex(wp) < 0 THEN
       dumi := ShowAlert( "The Window does not exist!",1,1);
       RETURN
    END; (* if *)
    FOR i := 0 TO CMaxWindows-1 DO
      IF TheWindows[i] <> NIL THEN
         EXCL( TheWindows[i]^.State, topped );
      END;
    END;
    INCL( wp^.State, open);
    INCL( wp^.State, topped);
    HideMouse; (* Any time you write to screen you must hide the mouse *)
    IF  ( wp^.Outer.X      <> DesktopWindow^.Outer.X )
    OR  ( wp^.Outer.Y      <> DesktopWindow^.Outer.Y )
    OR  ( wp^.Outer.Width  <> DesktopWindow^.Outer.Width )
    OR  ( wp^.Outer.Height <> DesktopWindow^.Outer.Height ) THEN
       CalcWorkareaSize(wp); (* re-calculate size for application *)
    END; (* if *)

    IF ( NAME IN wp^.Components ) THEN
        SetAWindowTitle(wp, wp^.Title);
    END;
    IF ( INFO IN wp^.Components ) THEN
        SetAWindowInfo(wp, wp^.Info);
    END;

    (* Draw the window *)
    IF Window.wind_open(wp^.Handle,
                        wp^.Outer.X,
                        wp^.Outer.Y,
                        wp^.Outer.Width,
                        wp^.Outer.Height )=0 THEN END;
    ClearAWindow(wp);
    wp^.PrevSize := wp^.Workarea;

    (* Re-show mouse *)
    ShowMouse;
  END OpenAWindow;


PROCEDURE ClearAWindow( wp : WindowPtr ); (* There is only 1 window *)
  VAR rectArray : CornersRect;
  BEGIN
    IF  ( topped IN wp^.State ) THEN
      HideMouse;
      ToCornersRect( wp^.Workarea, rectArray);
      VDI.vr_recfl( VDIHandle, rectArray.IntArray );
      ShowMouse;
   END; (* if *)
  END ClearAWindow;


PROCEDURE CloseAWindow( wp : WindowPtr );
  VAR  i : INTEGER;
  BEGIN
    IF ( GetWindowIndex(wp) < 0    ) THEN
       i := ShowAlert( "CloseWindow|The Window does not exist",1,1);

    ELSIF NOT ( open IN wp^.State ) THEN
       RETURN;

    ELSE
       i := Window.wind_close(wp^.Handle);
       wp^.State := WindowSSet{};
    END; (* if *)
  END CloseAWindow;


PROCEDURE DeleteAWindow( wp : WindowPtr ); (* Use handle in AWindow *)
  VAR   i : INTEGER;
      str : String;

  BEGIN
    i := GetWindowIndex(wp);
    IF i < 0 THEN RETURN; END;

    CloseAWindow(wp);
    i := Window.wind_delete(wp^.Handle);
    DestroyWindow(wp);
    DEC(WindowCount);
  END DeleteAWindow;


PROCEDURE TerminateApplication;
  VAR i : CARDINAL;
  BEGIN
    FOR i := 0 TO CMaxWindows-1 DO
      IF TheWindows[i] <> NIL THEN
         DeleteAWindow( TheWindows[i] );
      END; (* if *)
    END;
    DISPOSE( DesktopWindow );

    IF VDIHandle <> 0 THEN
       VDI.v_clsvwk(VDIHandle);
       IF appl_exit() = 0 THEN END;
    END; (* if *)
  END TerminateApplication;


PROCEDURE QueryIntersect(    Rect1, Rect2  : XYWHRect;
                 VAR Intersect        : XYWHRect;) : BOOLEAN;

    PROCEDURE Min( n1, n2 : INTEGER ) : INTEGER;
          BEGIN
            IF n1 < n2 THEN RETURN n1; ELSE RETURN n2; END;
          END Min;

    PROCEDURE Max( n1, n2 : INTEGER ) : INTEGER;
          BEGIN
            IF n1 > n2 THEN RETURN n1; ELSE RETURN n2; END;
          END Max;

  BEGIN (* QueryIntersect *)
    WITH Intersect DO
    Width  := Min( (Rect1.X + Rect1.Width), (Rect2.X + Rect2.Width) );
    Height := Min( (Rect1.Y + Rect1.Height),(Rect2.Y + Rect2.Height) );
    X      := Max( Rect1.X, Rect2.X );
    Y      := Max( Rect1.Y, Rect2.Y );
        Width  := CARDINAL(INTEGER(Width) - INTEGER(X));
        Height := CARDINAL(INTEGER(Height) - INTEGER(Y));
        RETURN (     (INTEGER(Width)  > 0)
                 AND (INTEGER(Height) > 0) );
    END;
  END QueryIntersect;


(* routines for getting rectangle list     *)
PROCEDURE SetUpdateRect( wp : WindowPtr; AreaRect : XYWHRect );

  BEGIN
    WITH wp^.RectList DO
      UpdateRect := AreaRect;
      First      := TRUE;
      Set        := TRUE;
    END;
  END SetUpdateRect;


PROCEDURE ResetRectList( wp : WindowPtr );
  BEGIN
    wp^.RectList.First := TRUE;
  END ResetRectList;


PROCEDURE GetNextRect( wp : WindowPtr;
                 VAR InterRect : XYWHRect; ) : BOOLEAN;
  CONST FirstXYWH   = 11;
        NextXYWH    = 12;

  VAR Intersect, More : BOOLEAN;

  BEGIN
    WITH InterRect DO
      LOOP
        IF wp^.RectList.First THEN
           dumc := Window.wind_get(wp^.Handle,
                                   FirstXYWH, X, Y, Width, Height);
           wp^.RectList.First := FALSE;
        ELSE
           dumc := Window.wind_get(wp^.Handle,
                                   NextXYWH, X, Y, Width, Height);
        END;
        IF ( Width <> 0 ) OR ( Height <> 0 ) THEN
           Intersect := QueryIntersect( wp^.RectList.UpdateRect,
                        InterRect,
                                 InterRect );
           IF Intersect THEN
              RETURN TRUE
           END;
        ELSE
           wp^.RectList.First := TRUE;
           RETURN FALSE;
        END;
      END; (* loop *)
    END; (* with *)
  END GetNextRect;


PROCEDURE Init;
  VAR i : INTEGER;
  BEGIN
    FOR i := 0 TO HIGH(TheWindows) DO
      TheWindows[i] := NIL;
    END;
    ScreenUpdateCount := 0;
    WindowCount :=    0;
    AESApplId     := -1;
    VDIHandle     := 0;
    ScreenResolution := getRez();
    NEW( DesktopWindow );
    IF DesktopWindow = NIL THEN
       dumc := ShowAlert('Unable To Create Window',1,1);
    ELSE
       DesktopWindow^.Handle := 0;
    END;
  END Init;


BEGIN (* Start of initialisation code *)
  Init;
END ManyWindows.